home *** CD-ROM | disk | FTP | other *** search
/ Workbench Add-On / Workbench Add-On - Volume 1.iso / Dev / TileForth / tst / structures.tst < prev    next >
Text File  |  1995-08-25  |  1KB  |  76 lines
  1. .( Loading Structures test...) cr
  2.  
  3. #include structures.f83
  4.  
  5. structures
  6.  
  7. .( 1: Print size of primitive fields) cr
  8.  
  9. sizeof byte .
  10. sizeof word .
  11. sizeof ptr  .
  12. sizeof long .
  13. sizeof enum .
  14. cr
  15.  
  16.  
  17. .( 2: Allocate some data) cr
  18. here . new-struct word . here . cr
  19.  
  20.  
  21. .( 3: Define a list structures) cr
  22.  
  23. struct.type LIST ( -- )
  24.   ptr +next ( list -- addr)
  25. struct.init ( list -- )
  26.   nil swap +next !
  27. struct.end
  28.  
  29. sizeof LIST . new-struct LIST dup . +next @ .  cr
  30.  
  31.  
  32. .( 4: Define a double linked list) cr
  33.  
  34. struct.type QUEUE ( flag -- )
  35.   struct LIST +succ ( queue -- addr)
  36.   struct LIST +pred ( queue -- addr)
  37. struct.init ( flag queue -- )
  38.   swap
  39.   if dup over +succ !
  40.     dup +pred !
  41.   else
  42.     dup +succ as LIST initiate
  43.     +pred as LIST initiate
  44.   then
  45. struct.end
  46.  
  47. sizeof QUEUE . cr
  48. true new-struct QUEUE dup . dup +succ +next @ . +pred +next @ . cr
  49. false new-struct QUEUE dup . dup +succ +next @ . +pred +next @ . cr
  50.  
  51.  
  52. .( 5: Define a block using double linked list and instance function) cr
  53.  
  54. struct.type BLOCK ( size -- )
  55.   struct QUEUE +queue ( block -- addr)
  56.   long +size ( block -- addr)
  57. struct.init ( size flag block -- )
  58.   tuck +queue as QUEUE initiate
  59.   over allot +size !
  60. struct.does ( block -- addr)
  61.   sizeof BLOCK +
  62. struct.end
  63.  
  64. : block ( addr -- block)  sizeof BLOCK - ;
  65. : size ( addr -- size)  block +size @ sizeof BLOCK + ;
  66.  
  67. sizeof BLOCK . 
  68. here 1000 true BLOCK x here swap - . 
  69. x . 
  70. x block . 
  71. x block +size @ .
  72. x size . cr
  73.  
  74. forth only
  75.  
  76.